home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / OGRID100 / DEMO_GL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-12-28  |  31KB  |  1,034 lines

  1. {*****************************************************************************
  2.  
  3.   OOGrid Library(TM) v1.0 for Borland/Turbo Pascal (Real Mode/TV)
  4.   Copyright (C) 1994 by Arturo J. Monge
  5.   Portions Copyright (C) 1989,1990 Borland International, Inc.
  6.  
  7.   OOGrid Library(TM) Demo Program:
  8.     Example program of how to use a TSpreadSheet object in an
  9.     application.  Demonstrates how to create, load and save
  10.     spreadsheets, how to modify the standard application palette
  11.     to support the use of a TSpreadSheet object and how to set up
  12.     the program resources so that they can be used by the
  13.     TSpreadSheet object.
  14.  
  15.   Copyright (C) 1994 by Arturo J. Monge
  16.  
  17.   Last Modification : December 29th, 1994
  18.  
  19. *****************************************************************************}
  20.  
  21. program OOGL_DemoProgram;
  22.  
  23. {_$DEFINE TP60} { Eliminate _ from definition to compile with TP60 }
  24.  
  25. {$O+,F+,X+}
  26.  
  27. uses Dos, App, Objects, Views, Drivers, Gadgets, MsgBox, Menus, Memory,
  28.      HelpFile, StdDlg, Dialogs, GLViews, GLEquate, GLWindow, GLTSheet,
  29.      GLSupprt, DemoEqu,
  30.      TCUtil { OOGL_DemoProgram uses TCUtil's UpperCase function };
  31.  
  32. var
  33.   DemoStrings : PStringList;
  34.   { String list used by OOGL_DemoProgram }
  35.  
  36.   DemoResource : TResourceFile;
  37.   { Resource file used by OOGL_DemoProgram }
  38.  
  39. const
  40.   ResourceFileName = 'DEMO_GL.TVR';
  41.   { Filename of the file that contains the resource used by OOGL_DemoProgram }
  42.  
  43. const
  44.   HelpInUse : Boolean = False;
  45.   { Is set to true when the help window is active }
  46.  
  47. const
  48.   MaxNumberOfFiles = 255;
  49.  
  50. type
  51.   FileNumbers = Set of 1..MaxNumberOfFiles;
  52.  
  53. var
  54.   FilesOpen  : FileNumbers;
  55.   { Keeps track of which FileNumbers are currently in use }
  56.  
  57.   SaveMem : LongInt;
  58.   { Used to determine if all memory has been properly disposed by the program }
  59.  
  60. function CalcName(AName: String): PathStr; forward;
  61. function NewNumberAvailable (var NewFileNumber:Integer;
  62.   var FilesOpen:FileNumbers):Boolean; forward;
  63.  
  64. type
  65.   POOGridLibraryDemo = ^TOOGridLibraryDemo;
  66.   TOOGridLibraryDemo = object(TApplication)
  67.       HelpFile   : PathStr;
  68.       Clock      : PClockView;
  69.       HeapViewer : PHeapView;
  70.     constructor Init(HelpFileName: String);
  71.     procedure AddClock; virtual;
  72.     procedure AddHeapViewer; virtual;
  73.     procedure AddSpreadSheet; virtual;
  74.     function GetPalette:PPalette; virtual;
  75.     procedure GetEvent (var Event:TEvent); virtual;
  76.     procedure HandleEvent (var Event : TEvent); virtual;
  77.     procedure Idle; virtual;
  78.     procedure InitMenuBar; virtual;
  79.     procedure InitStatusLine; virtual;
  80.     procedure LoadSpreadSheet(FileName: PathStr); virtual;
  81.     procedure SaveSpreadSheet(NewName: Boolean); virtual;
  82.     procedure OutofMemory; virtual;
  83.     procedure ShowWindowList; virtual;
  84.     destructor Done; virtual;
  85.   end; {...TOOGridLibraryDemo }
  86.  
  87.  
  88.   PHCStatusLine = ^THCStatusLine;
  89.   THCStatusLine = object(TStatusLine)
  90.     function Hint(AHelpCtx: Word): String; virtual;
  91.   end; {...THCStatusLine }
  92.  
  93.  
  94.   PMySpreadSheet = ^TMySpreadSheet;
  95.   TMySpreadSheet = object(TSpreadSheetWindow)
  96.   { A descendant of TSpreadSheetWindow that owns a TSpreadSheet object.
  97.     An instance of TSpreadSheet is created and inserted into TMySpreadSheet
  98.     in the Init method.  It also overrides the GetPalette method to map the
  99.     color entries the standard palette entries after the help system's
  100.     palette }
  101.     constructor Init(Bounds : TRect; ATitle : String; ANumber: Byte);
  102.     function GetPalette: PPalette; virtual;
  103.     destructor Done; virtual;
  104.   end; {...TMySpreadSheet }
  105.  
  106.  
  107.   PWinTitleCollection = ^TWinTitleCollection;
  108.   TWinTitleCollection = object(TStringCollection)
  109.   { Aa string collection used by TWindowList that doesn't cause a run-time
  110.     error whenever an error ocurrs.  Instead, it set the Status attribute to
  111.     1 when an error ocurrs.  This is to avoid an unwanted run-time error when
  112.     there is not enough memory to list all active windows in a TWindowList
  113.     object }
  114.       Status : Byte; { Status of the collection:
  115.                        0 : OK
  116.                        1 : Error ocurred }
  117.     constructor Init(ALimit, ADelta: Integer);
  118.     procedure Error(Code, Info: Integer); virtual;
  119.   end; {...TWinTitle Collection }
  120.  
  121.  
  122.  
  123.   PWindowListBox = ^TWindowListBox;
  124.   TWindowListBox = object(TSortedListBox)
  125.   { Handles double-clicking by generating a cmOk command. It is used by
  126.     TWindowList to list all open windows. }
  127.     procedure HandleEvent(var Event:TEvent); virtual;
  128.   end; {...TWindowListBox }
  129.  
  130.  
  131.  
  132.   PWindowList = ^TWindowList;
  133.   TWindowList = object(TDialog)
  134.   { A dialog that allows the user to select or delete a window in the desktop
  135.     from a list }
  136.       WinBox : PWindowListBox;
  137.     constructor Init(Bounds:TRect);
  138.     procedure BuildWindowList(var TitleList: PWinTitleCollection);
  139.     procedure DeleteWindow;
  140.     procedure HandleEvent(var Event:TEvent); virtual;
  141.     constructor Load(var S: TStream);
  142.     procedure SelectWindow;
  143.     procedure Store(var S: TStream);
  144.     destructor Done; virtual;
  145.   end; {...TWindowList }
  146.  
  147.  
  148. {** THCStatusLine **}
  149.  
  150. function THCStatusLine.Hint(AHelpCtx: Word): String;
  151. begin
  152.    Hint := DemoStrings^.Get(AHelpCtx);
  153. end; {...THCStatusLine.Hint }
  154.  
  155.  
  156. {** TMySpreadSheet **}
  157.  
  158. constructor TMySpreadSheet.Init(Bounds: TRect; ATitle: String; ANumber: Byte);
  159. var
  160.    R : TRect;
  161.    SpreadSheet : PSpreadSheet;
  162. begin
  163.    TSpreadSheetWindow.Init(Bounds, ATitle, ANumber);
  164.    GetExtent(R);
  165.    R.Grow(-1,-1);
  166.    SpreadSheet := New(PSpreadSheet, Init(R, 0, DefaultEmptyRowsAtTop,
  167.      DefaultEmptyRowsAtBottom, StandardScrollBar(sbHorizontal),
  168.      StandardScrollBar(sbVertical),DefaultMaxCols, DefaultMaxRows,
  169.      DefaultDefaultColWidth, DefaultDefaultDecimalPlaces,
  170.      DefaultMaxDecimalPlaces, DefaultCurrencyString));
  171.  
  172.    { You should call the SetNumber method to assign a number to
  173.      the spreadsheet, which will be displayed as a letter in the
  174.      information area }
  175.    SpreadSheet^.SetNumber(ANumber);
  176.  
  177.    Insert(SpreadSheet);
  178. end; {...TMySpreadSheet.Init }
  179.  
  180. function TMySpreadSheet.GetPalette: PPalette;
  181. const
  182.   CNewPalette = CBlueWindow + CSpreadSheetWindow2;
  183.   PNewPalette : string[Length(CNewPalette)] = CNewPalette;
  184. begin
  185.   GetPalette := @PNewPalette;
  186. end; {...TMySpradSheet.GetPalette }
  187.  
  188. destructor TMySpreadSheet.Done;
  189. begin
  190.   { Make available the number used by the instance of TMySpreadSheet
  191.     being closed }
  192.   FilesOpen := FilesOpen - [Number];
  193.   TSpreadSheetWindow.Done;
  194. end; {...TMySpreadSheet.Done }
  195.  
  196.  
  197.  
  198. {** TOOGridLibraryDemo **}
  199.  
  200. constructor TOOGridLibraryDemo.Init(HelpFileName: String);
  201. begin
  202.   TApplication.Init;
  203.   if HelpFileName = '' then
  204.     HelpFile := ''
  205.   else
  206.     HelpFile := CalcName(HelpFileName);
  207.   FilesOpen := [];
  208.   AddClock;
  209.   AddHeapViewer;
  210. end; {...TOOGridLibraryDemo.Init }
  211.  
  212.  
  213. procedure TOOGridLibraryDemo.AddClock;
  214. { Adds a clock to the application in the upper right corner }
  215. var
  216.   R : TRect;
  217. begin
  218.   GetExtent(R);
  219.   R.B.Y := R.A.Y + 1;
  220.   R.A.X := R.B.X - 9;
  221.   Clock := New(PClockView, Init(R));
  222.   Insert(Clock);
  223. end; {...TOOGridLibraryDemo.AddClock }
  224.  
  225.  
  226. procedure TOOGridLibraryDemo.AddHeapViewer;
  227. { Insert an indicator of the available memory in the lower left corner }
  228. var
  229.   R : TRect;
  230. begin
  231.   GetExtent(R);
  232.   R.A.Y := R.B.Y - 1;
  233.   R.A.X := R.B.X - 9;
  234.   HeapViewer := New(PHeapView, Init(R));
  235.   Insert(HeapViewer);
  236. end; {...TOOGridLibraryDemo.AddHeapViewer }
  237.  
  238.  
  239. procedure TOOGridLibraryDemo.AddSpreadSheet;
  240. { Creates a new spreadsheet and inserts it in the desktop }
  241. var
  242.    NewNumber : Integer;
  243.    NumberStr : String;
  244.    SpreadSheet : PMySpreadSheet;
  245.    R, Limits : TRect;
  246. begin
  247.   if not NewNumberAvailable(NewNumber, FilesOpen) then
  248.   begin
  249.     MessageBox(DemoStrings^.Get(sMaxFilesOpenError), NIL,
  250.       mfError + mfOkButton);
  251.     Exit;
  252.   end; {...if not NewNumberAvailable(NewNumber, FilesOpen) }
  253.  
  254.   { Determine the window's new bounds }
  255.  
  256.   if Desktop^.Current <> NIL then
  257.     begin
  258.       R.A := Desktop^.Current^.Origin;
  259.       R.B.X := R.A.X + Desktop^.Current^.Size.X;
  260.       R.B.Y := R.A.Y + Desktop^.Current^.Size.Y;
  261.       Inc(R.A.X);
  262.       Inc(R.A.Y);
  263.     end {...if Desktop^.Current <> NIL }
  264.   else
  265.     Desktop^.GetExtent(R);
  266.   Str(NewNumber, NumberStr);
  267.   SpreadSheet := New(PMySpreadSheet, Init(R,
  268.     DemoStrings^.Get(sNoNameFileName)+NumberStr, NewNumber));
  269.  
  270.   { Verify that the new bounds are not below the allowed limits }
  271.   SpreadSheet^.SizeLimits(Limits.A, Limits.B);
  272.   if ((R.B.Y - R.A.Y) < Limits.A.Y) or ((R.B.X - R.A.X) < Limits.A.X) then
  273.   begin
  274.     Desktop^.GetExtent(R);
  275.     SpreadSheet^.ChangeBounds(R);
  276.   end; {...if ((R.B.Y - R.A.Y) < Limits.A.Y) or ... }
  277.  
  278.   Desktop^.Insert(SpreadSheet);
  279.   EnableCommands([cmSave, cmSaveAs, cmPrintSheet, cmYes, cmNo, cmCloseAll]);
  280. end;
  281.  
  282. function TOOGridLibraryDemo.GetPalette: PPalette;
  283. { Adds palette items to the standard application palette for the help system
  284.   and for the TSpreadSheet object}
  285. const
  286.   CNewColor = CColor + CHelpColor + CSpreadSheetColor;
  287.   CNewBlackWhite = CBlackWhite + CHelpBlackWhite + CSpreadSheetBlackWhite;
  288.   CNewMonochrome = CMonochrome + CHelpMonochrome + CSpreadSheetMonochrome;
  289.   P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
  290.     (CNewColor, CNewBlackWhite, CNewMonochrome);
  291. begin
  292.   GetPalette := @P[AppPalette];
  293. end; {...TOOGridLibraryDemo.GetPalette }
  294.  
  295.  
  296. procedure TOOGridLibraryDemo.GetEvent(var Event: TEvent);
  297. { Handles the cmHelp command by displaying context sensitive help }
  298. var
  299.   HelpBox    : PWindow;
  300.   HFile      : PHelpFile;
  301.   HelpStrm   : PDosStream;
  302. begin
  303.   TApplication.GetEvent(Event);
  304.   case Event.What of
  305.     evCommand:
  306.       if (Event.Command = cmHelp) and (HelpFile <> '') and
  307.         not HelpInUse then
  308.       begin
  309.         HelpInUse := True;
  310.         HelpStrm := New(PBufStream, Init(HelpFile, stOpenRead, 2048));
  311.         HFile := New(PHelpFile, Init(HelpStrm));
  312.         if HelpStrm^.Status <> stOk then
  313.           begin
  314.             MessageBox(DemoStrings^.Get(sHelpAccessError), NIL,
  315.               mfError + mfCancelButton);
  316.             Dispose(HFile, Done);
  317.             ClearEvent(Event);
  318.           end {...if HelpStrm^.Status <> stOk }
  319.         else
  320.           begin
  321.             HelpBox := New(PHelpWindow,Init(HFile, GetHelpCtx));
  322.             if ValidView(HelpBox) <> nil then
  323.             begin
  324.               ExecView(HelpBox);
  325.               Dispose(HelpBox, Done);
  326.             end; {...if ValidView(HelpBox) <> NIL }
  327.             ClearEvent(Event);
  328.           end; {...else/if }
  329.         HelpInUse := False;
  330.       end; {...if (Event.Command = cmHelp) and not HelpInUse }
  331.  
  332.     evMouseDown:
  333.       if Event.Buttons <> 1 then
  334.         Event.What := evNothing;
  335.   end; {...case Event.What }
  336. end; {...TOOGridLibraryDemo.GetEvent }
  337.  
  338.  
  339. procedure TOOGridLibraryDemo.HandleEvent(VAR Event : TEvent);
  340. { Handles common commands like cmTile, cmCascade, cmDosShell, cmVideoMode
  341.   and cmList, plus application especific commands }
  342.  
  343.     procedure ChangeVideo;
  344.     var
  345.       NewMode : Word;
  346.     begin
  347.       Dispose(HeapViewer, Done);
  348.       NewMode := ScreenMode xor smFont8x8;
  349.       if NewMode and smFont8x8 <> 0 then
  350.         ShadowSize.X := 1
  351.       else
  352.         ShadowSize.X := 2;
  353.       SetScreenMode(NewMode);
  354.       AddHeapViewer;
  355.     end; {...ChangeVideo }
  356.  
  357.     procedure GoToDos;
  358.     begin
  359.       DoneSysError;
  360.       DoneEvents;
  361.       DoneVideo;
  362.       DoneMemory;
  363.       SetMemTop(HeapPtr);
  364.       PrintStr(DemoStrings^.Get(sShellMsg));
  365.       SwapVectors;
  366.       Exec(GetEnv('COMSPEC'), '');
  367.       SwapVectors;
  368.       SetMemTop(HeapEnd);
  369.       InitMemory;
  370.       InitVideo;
  371.       InitEvents;
  372.       InitSysError;
  373.       Redraw;
  374.     end; {...GoToDos }
  375.  
  376. {$IFDEF TP60}
  377.  
  378.     procedure Tile;
  379.     var
  380.       R: TRect;
  381.     begin
  382.       Desktop^.GetExtent(R);
  383.       Desktop^.Tile(R);
  384.     end; {...Tile }
  385.  
  386.     procedure Cascade;
  387.     var
  388.       R: TRect;
  389.     begin
  390.       Desktop^.GetExtent(R);
  391.       Desktop^.Cascade(R);
  392.     end; {...Cascade }
  393.  
  394. {$ENDIF }
  395.  
  396.     procedure CloseAll;
  397.     { Close all open windows in the desktop, by disposing it and
  398.       creating a new instance of TDesktop }
  399.     begin
  400.        Dispose(Desktop, Done);
  401.        InitDesktop;
  402.        Insert(Desktop);
  403.     end; {...CloseAll }
  404.  
  405.     procedure DisplayDialog(ResourceKey: String);
  406.     var
  407.       Dialog : PDialog;
  408.     begin
  409.       Dialog := PDialog(DemoResource.Get(ResourceKey));
  410.       if Application^.ValidView(Dialog) <> NIL then
  411.         Desktop^.ExecView(Dialog);
  412.       if Dialog <> NIL then
  413.         Dispose(Dialog, Done);
  414.     end; {...DisplayDialog }
  415.  
  416.  
  417.  
  418. begin
  419.   TApplication.HandleEvent(Event);
  420.   if (Event.what = evCommand) then
  421.     case Event.Command of
  422.       cmAbout         : DisplayDialog('AboutDialog');
  423.       cmAuthorInfo    : DisplayDialog('AuthorDialog');
  424.       cmCascade       : Cascade;
  425.       cmChDir         : DisplayDialog('ChDirDialog');
  426.       cmCloseAll      : CloseAll;
  427.       cmDosShell      : GoToDos;
  428.       cmList          : ShowWindowList;
  429.       cmLoadLicense   : LoadSpreadSheet(CalcName('EX_LICEN.OGL'));
  430.       cmLoadTypes     : LoadSpreadSheet(CalcName('EX_TYPES.OGL'));
  431.       cmLoadFunctions : LoadSpreadSheet(CalcName('EX_FUNCT.OGL'));
  432.       cmLoadList1     : LoadSpreadSheet(CalcName('EX_LIST1.OGL'));
  433.       cmLoadList2     : LoadSpreadSheet(CalcName('EX_LIST2.OGL'));
  434.       cmLoadErrors    : LoadSpreadSheet(CalcName('EX_ERROR.OGL'));
  435.       cmLoadDataEntry : LoadSpreadSheet(CalcName('EX_ENTRY.OGL'));
  436.       cmLoadOOGL2     : LoadSpreadSheet(CalcName('EX_OOGL2.OGL'));
  437.       cmNewSheet      : AddSpreadSheet;
  438.       cmOpen          : LoadSpreadSheet('');
  439.       cmRefresh       : Application^.Redraw;
  440.       cmRegister      : DisplayDialog('RegistrationDialog');
  441.       cmSave          : SaveSpreadSheet(False);
  442.       cmSaveAs        : SaveSpreadSheet(True);
  443.       cmTile          : Tile;
  444.       cmVideoMode     : ChangeVideo;
  445.     end; {...case Event.Command }
  446. end; {...TOOGridLibraryDemo.HandleEvent }
  447.  
  448.  
  449. procedure TOOGridLibraryDemo.Idle;
  450. { Determines if the current view is tileable and enables or disables menu
  451.   commands accordingly.  It also updates the clock and the heap viewer }
  452.  
  453.     function IsTileable(P: PView): Boolean; far;
  454.     begin
  455.       IsTileable := P^.Options and ofTileable <> 0;
  456.     end; {...IsTileable }
  457.  
  458. begin
  459.   TApplication.Idle;
  460.   if not (Clock = NIL) then
  461.      Clock^.Update;
  462.   if not (HeapViewer = NIL) then
  463.      HeapViewer^.Update;
  464.   If Desktop^.FirstThat(@IsTileable) <> nil then
  465.     EnableCommands([cmTile, cmCascade])
  466.   else
  467.     DisableCommands([cmTile, cmCascade]);
  468.   if (DeskTop^.Current = NIL) and (HelpInUse = False) then
  469.     SetCommands ([cmNewSheet, cmOpen, cmDosShell, cmQuit, cmList, cmHelp,
  470.       cmChDir, cmAbout, cmAuthorInfo, cmRegister, cmRefresh, cmVideoMode,
  471.       cmOk, cmDeleteWin, cmCancel, cmMenu, cmLoadLicense, cmLoadTypes,
  472.       cmLoadFunctions, cmLoadList1, cmLoadList2, cmLoadErrors,
  473.       cmLoadDataEntry, cmLoadOOGL2]);
  474. end; {...TOOGridLibraryDemo.Idle }
  475.  
  476.  
  477. procedure TOOGridLibraryDemo.InitMenuBar;
  478. begin
  479.   MenuBar := PMenuBar(DemoResource.Get('MenuBar'));
  480. end; {...TOOGridLibraryDemo.InitMenuBar }
  481.  
  482. procedure TOOGridLibraryDemo.InitStatusLine;
  483. var
  484.   R : TRect;
  485. begin
  486.   R.Assign(0, 24, 80, 25);
  487.   StatusLine := New(PHCStatusLine, Init(R,
  488.     NewStatusDef(0, 1000,
  489.        NewStatusKey('~Alt-F1~ Info', kbAltF1, cmAbout,
  490.        NewStatusKey('', kbF10, cmMenu,
  491.        NewStatusKey('', kbAltX, cmQuit,
  492.        NewStatusKey('', kbAltF3, cmClose,
  493.        NewStatusKey('', kbF5, cmZoom,
  494.        NewStatusKey('', kbCtrlF5, cmResize,
  495.        NewStatusKey('', kbF6, cmNext,
  496.        NIL))))))),
  497.     NIL)));
  498. end; {...TOOGridLibraryDemo.InitStatusBar }
  499.  
  500. procedure TOOGridLibraryDemo.LoadSpreadSheet(FileName: PathStr);
  501. { Loads a spreadsheet from disk }
  502. var
  503.   Stream : PBufStream;
  504.   Dialog : PDialog;
  505.   NewSS : PMySpreadSheet;
  506.   NewNumber : Integer;
  507.   R, Limits : TRect;
  508. begin
  509.   if FileName = '' then
  510.   begin
  511.     Dialog := PDialog(DemoResource.Get('LoadDialog'));
  512.     if Application^.ValidView(Dialog) = NIL then
  513.        Exit
  514.     else
  515.       begin
  516.         if Desktop^.ExecView(Dialog) <> cmCancel then
  517.            Dialog^.GetData(FileName)
  518.         else
  519.            begin
  520.               Dispose(Dialog, Done);
  521.               Exit;
  522.            end; {...if/else }
  523.       end; {...if/else }
  524.     Dispose(Dialog, Done);
  525.   end; {...if FileName = '' }
  526.   Stream := New(PBufStream, Init(FileName, stOpenRead, 1024));
  527.   if Stream^.Status <> 0 then
  528.   begin
  529.     MessageBox(DemoStrings^.Get(sFileNotFound), NIL, mfError + mfOkButton);
  530.     Exit;
  531.   end; {...if Stream^.Status <> 0 }
  532.   DisplayMessage(DemoStrings^.Get(sLoadMessage));
  533.   NewSS := PMySpreadSheet(Stream^.Get);
  534.   EraseMessage;
  535.   if Stream^.Status <> 0 then
  536.   begin
  537.     if Stream^.Status = stInvalidFormatError then
  538.     { Two new stream status constants are used by OOGrid Library(TM) v1.0:
  539.       stInvalidFormatError and stNoMemoryError.  They are defined in
  540.       the GLSupprt unit }
  541.       MessageBox(DemoStrings^.Get(sInvalidFormat), NIL, mfError + mfOkButton)
  542.     else if Stream^.Status <> stNoMemoryError then
  543.     { Memory errors are reported by the LowMemory function; there is no
  544.       need to report them again }
  545.       MessageBox(DemoStrings^.Get(sAccessError), NIL, mfError + mfOkButton);
  546.     Dispose(NewSS, Done);
  547.     Dispose(Stream, Done);
  548.     Exit;
  549.   end; {...if Stream^.Status <> 0 }
  550.   Dispose(Stream, Done);
  551.   if not NewNumberAvailable(NewNumber, FilesOpen) then
  552.   begin
  553.     MessageBox(DemoStrings^.Get(sMaxFilesOpenError), NIL,
  554.       mfError + mfOkButton);
  555.     Exit;
  556.   end; {...if not NewNumberAvailable(NewNumber, FilesOpen) }
  557.  
  558.   { Set the title to the current filename }
  559.   if NewSS^.Title <> NIL then
  560.     DisposeStr(NewSS^.Title);
  561.   NewSS^.Title := NewStr(FileName);
  562.  
  563.   NewSS^.Number := NewNumber;
  564.  
  565.   { Set the spreadsheet's number that will be displayed as a letter
  566.     in the information area }
  567.   PSpreadSheet(NewSS^.First)^.SetNumber(NewNumber);
  568.  
  569.   { Determine the window's new bounds }
  570.   if Desktop^.Current <> NIL then
  571.     begin
  572.       R.A := Desktop^.Current^.Origin;
  573.       R.B.X := R.A.X + Desktop^.Current^.Size.X;
  574.       R.B.Y := R.A.Y + Desktop^.Current^.Size.Y;
  575.       Inc(R.A.X);
  576.       Inc(R.A.Y);
  577.  
  578.       { Verify that the new bounds are not below the allowed limits }
  579.       NewSS^.SizeLimits(Limits.A, Limits.B);
  580.       if ((R.B.Y - R.A.Y) < Limits.A.Y) or ((R.B.X - R.A.X) < Limits.A.X) then
  581.         Desktop^.GetExtent(R);
  582.     end {...if Desktop^.Current <> NIL }
  583.   else
  584.     Desktop^.GetExtent(R);
  585.  
  586.   NewSS^.ChangeBounds(R);
  587.   Desktop^.Insert(NewSS);
  588.   EnableCommands([cmSave, cmSaveAs, cmPrintSheet, cmYes, cmNo, cmCloseAll]);
  589. end; {..TOOGridLibraryDemo.LoadSpreadSheet }
  590.  
  591.  
  592. procedure TOOGridLibraryDemo.OutofMemory;
  593. var
  594.   R : TRect;
  595. begin
  596.   R.Assign(20,8,58,17);
  597.   MessageBox(DemoStrings^.Get(sNoMemError), NIL, mfError + mfCancelButton);
  598. end; {...TOOGridLibraryDemo.OutOfMemory }
  599.  
  600.  
  601. procedure TOOGridLibraryDemo.SaveSpreadSheet(NewName: Boolean);
  602. { Saves a spreadsheet to disk }
  603. var
  604.   Stream : PBufStream;
  605.   Dialog : PDialog;
  606.   CurrSS : PMySpreadSheet;
  607.   FileName : PathStr;
  608. begin
  609.   CurrSS := PMySpreadSheet(Desktop^.Current);
  610.  
  611.   if NewName or (Copy(CurrSS^.Title^, 1,
  612.     Length(DemoStrings^.Get(sNoNameFileName))) =
  613.     DemoStrings^.Get(sNoNameFileName)) then
  614.   { if the file will be saved under a new name or if the file does not
  615.     have a name, prompt the user for a new name }
  616.     begin
  617.       Dialog := PDialog(DemoResource.Get('SaveDialog'));
  618.       if Application^.ValidView(Dialog) = NIL then
  619.          Exit
  620.       else
  621.         begin
  622.           if Desktop^.ExecView(Dialog) <> cmCancel then
  623.             begin
  624.               Dialog^.GetData(FileName);
  625.  
  626.               { Change the window's title }
  627.               if CurrSS^.Title <> NIL then
  628.                 DisposeStr(CurrSS^.Title);
  629.               CurrSS^.Title := NewStr(FileName);
  630.               CurrSS^.Redraw;
  631.             end {...if Desktop^.ExecView(Dialog) <> cmCancel }
  632.           else
  633.              begin
  634.                 Dispose(Dialog, Done);
  635.                 Exit;
  636.              end; {...if/else }
  637.           end; {...if else }
  638.       Dispose(Dialog, Done);
  639.     end {...if NewName or ... }
  640.   else
  641.     FileName := CurrSS^.Title^;
  642.   Stream := New(PBufStream, Init(FileName, stCreate, 1024));
  643.   if Stream^.Status <> 0 then
  644.   begin
  645.     MessageBox(DemoStrings^.Get(sCreateStreamError), NIL, mfError +
  646.       mfOkButton);
  647.     Dispose(Stream, Done);
  648.     Exit;
  649.   end; {...if Stream^.Status <> 0 }
  650.   DisplayMessage(DemoStrings^.Get(sSaveMessage));
  651.   Stream^.Put(Desktop^.Current);
  652.   EraseMessage;
  653.   if Stream^.Status <> 0 then
  654.     MessageBox(DemoStrings^.Get(sSaveError), NIL, mfError + mfOkButton);
  655.   Dispose(Stream, Done);
  656.  
  657. end; {..TOOGridLibraryDemo.SaveSpreadSheet }
  658.  
  659.  
  660. procedure TOOGridLibraryDemo.ShowWindowList;
  661. { Shows a dialog for selecting a window from a list of active windows }
  662.  
  663. var
  664.   WindowLst    : PWindowList;
  665.   CurrSelected : PWindow;
  666.   R            : TRect;
  667. begin
  668.   R.Assign(0,0,60,15);
  669.   WindowLst := New(PWindowList, Init(R));
  670.   if Application^.ValidView(WindowLst) <> NIL then
  671.   begin
  672.     If (ExecView(WindowLst) <> cmCancel) then
  673.     begin
  674.       CurrSelected := PWindow(DeskTop^.Current);
  675.       If (CurrSelected^.Flags and wfClose <> 0) then
  676.         EnableCommands([cmClose])
  677.       else
  678.         DisableCommands([cmClose]);
  679.       CommandSetChanged := True;
  680.     end; {...if (ExecView(WindowLst) <> cmCancel) }
  681.     Dispose(WindowLst, Done);
  682.   end; {...if (Application^.ValidView(WindowLst) = PView(WindowLst)) }
  683. end; {...ShowWindowList }
  684.  
  685.  
  686. destructor TOOGridLibraryDemo.Done;
  687. begin
  688.   if not (Clock = NIL) then
  689.      Dispose(Clock, Done);
  690.   if not (HeapViewer = NIL) then
  691.      Dispose(HeapViewer, Done);
  692.   TApplication.Done;
  693. end; {...TOOGridLibraryDemo.Done }
  694.  
  695.  
  696.  
  697. {** TWindowList **}
  698.  
  699. constructor TWindowList.Init(Bounds: TRect);
  700. { The BuildList parameter tells the object if it should or should not
  701.   build the list of open windows. }
  702. var
  703.   SizeX, SizeY : Integer;
  704.   Control : PView;
  705.   TitleList : PWinTitleCollection;
  706.   WinBoxLabel : String;
  707.   R : TRect;
  708. begin
  709.   SizeX := (Bounds.B.X - Bounds.A.X);
  710.   SizeY := (Bounds.B.Y - Bounds.A.Y);
  711.   If ((SizeY MOD 2) = 0) then
  712.   begin
  713.     Inc(Bounds.B.Y);
  714.     Inc(SizeY);
  715.   end; {...if ((SizeY MOD 2) = 0) }
  716.   TDialog.Init(Bounds, 'Window list...');
  717.   HelpCtx := hcWinListDlgHelp;
  718.   Options := Options + ofCentered;
  719.  
  720.   R.A.X := (SizeX - 14);
  721.   R.A.Y := 3;
  722.   R.B.X := (R.A.X + 12);
  723.   R.B.Y := 5;
  724.   Control := New(PButton, Init(R, '~O~k', cmOk, bfDefault));
  725.   Control^.HelpCtx := hcOk;
  726.   Insert(Control);
  727.  
  728.   R.A.X := (SizeX - 14);
  729.   R.A.Y := (((SizeY - 5) DIV 3) + 3);
  730.   R.B.X := (R.A.X + 12);
  731.   R.B.Y := R.A.Y + 2;
  732.   Control := New(PButton, Init(R, '~D~elete', cmDeleteWin, bfNormal));
  733.   Control^.HelpCtx := hcDeleteWin;
  734.   Insert(Control);
  735.  
  736.   R.A.X := (SizeX - 14);
  737.   R.A.Y := (SizeY - 3)-((SizeY - 5) DIV 3);
  738.   R.B.X := (R.A.X + 12);
  739.   R.B.Y := R.A.Y + 2;
  740.   Control := New(PButton, Init(R, 'Cancel', cmCancel, bfNormal));
  741.   Control^.HelpCtx := hcCancel;
  742.   Insert(Control);
  743.  
  744.   R.A.X := (SizeX - 14);
  745.   R.A.Y := (SizeY - 3);
  746.   R.B.X := (R.A.X + 12);
  747.   R.B.Y := R.A.Y + 2;
  748.   Control := New(PButton, Init(R, 'Help', cmHelp, bfNormal));
  749.   Insert(Control);
  750.  
  751.   R.A.X := (SizeX - 16);
  752.   R.A.Y := 3;
  753.   R.B.X := R.A.X + 1;
  754.   R.B.Y := (SizeY - 2);
  755.   Control := New(PScrollBar, Init(R));
  756.   Insert(Control);
  757.  
  758.   R.A.X := 3;
  759.   R.A.Y := 3;
  760.   R.B.X := (SizeX - 16);
  761.   R.B.Y := (SizeY - 2);
  762.   WinBox := New(PWindowListBox, Init(R, 1, PScrollBar(Control)));
  763.   TitleList := New(PWinTitleCollection, Init(12,1));
  764.   BuildWindowList(TitleList);
  765.   WinBox^.NewList(TitleList);
  766.   WinBox^.HelpCtx := hcWinList;
  767.   Insert(WinBox);
  768.  
  769.   WinBoxLabel := '~W~indows';
  770.   R.A.X := 2;
  771.   R.A.Y := 2;
  772.   R.B.X := R.A.X + Length(WinBoxLabel);
  773.   R.B.Y := 3;
  774.   Insert(New(PLabel, Init(R, WinBoxLabel, WinBox)));
  775. end; {...TWindowList.Init }
  776.  
  777.  
  778. procedure TWindowList.BuildWindowList(var TitleList: PWinTitleCollection);
  779. { Builds a list of all selectable active windows in the desktop }
  780. var
  781.   Curr     : PWindow;
  782.   ListText : PString;
  783. begin
  784.   if not(DeskTop^.Current = NIL) then
  785.   begin
  786.     Curr := PWindow(DeskTop^.First);
  787.     repeat
  788.       if (Curr^.Options and ofSelectable <> 0) then
  789.       begin
  790.         ListText := NewStr(UpperCase(Curr^.Title^));
  791.         TitleList^.Insert(ListText);
  792.       end; {...if (Curr^.Options and ofSelectable <> 0) }
  793.       Curr := PWindow(Curr^.Next);
  794.     until (Curr = PWindow(DeskTop^.Last)) or (TitleList^.Status = 1);
  795.     if TitleList^.Status = 1 then
  796.        MessageBox('Not enough memory to list all open windows.', NIL,
  797.                   mfInformation + mfOkButton);
  798.   end; {...if not(DeskTop^.Current = NIL) }
  799. end; {...TWindowList.BuildWindowList }
  800.  
  801.  
  802. procedure TWindowList.DeleteWindow;
  803. { Closes a window in the desktop }
  804.  
  805.     function SameTitle(CurrWin: PWindow): boolean; Far;
  806.     begin
  807.       if CurrWin^.Title^ = WinBox^.GetText(WinBox^.Focused, 80) then
  808.          SameTitle := True
  809.       else
  810.          SameTitle := False;
  811.     end; {...SameTitle }
  812.  
  813. var
  814.   DelMessage   : Pointer;
  815.   WinFocused   : Integer;
  816.   ViewToDelete : PWindow;
  817. begin
  818.   ViewToDelete := PWindow(DeskTop^.FirstThat(@SameTitle));
  819.   if not (ViewToDelete = NIL) and
  820.      (ViewToDelete^.Flags and wfClose <> 0) then
  821.   begin
  822.     DelMessage := Message(ViewToDelete, evCommand, cmClose, nil);
  823.     WinFocused := WinBox^.Focused;
  824.     WinBox^.List^.AtFree(WinFocused);
  825.     Dec(WinBox^.Range);
  826.     If (WinFocused > (WinBox^.Range - 1)) and (Winbox^.Range > 1) then
  827.       WinBox^.FocusItem(WinBox^.Range - 1);
  828.     WinBox^.DrawView;
  829.   end; {...if not(ViewToDelete = NIL) and ... }
  830. end; {...TWindowList.DeleteWindow }
  831.  
  832.  
  833. procedure TWindowList.HandleEvent(var Event: TEvent);
  834. { Handles the events for selecting and deleting windows in the desktop }
  835. begin
  836.   if (Event.what = evCommand) then
  837.     case Event.Command of
  838.       cmOk         : SelectWindow;
  839.       cmDeleteWin  : DeleteWindow;
  840.     end; {...case Event.Command }
  841.   TDialog.HandleEvent(Event);
  842. end; {...TWindowList.HandleEvent }
  843.  
  844. constructor TWindowList.Load(var S: TStream);
  845. { Loads the dialog from a stream }
  846. var
  847.    TitleList : PWinTitleCollection;
  848. begin
  849.   TDialog.Load(S);
  850.   GetSubViewPtr(S, WinBox);
  851.   TitleList := New(PWinTitleCollection, Init(12,1));
  852.   BuildWindowList(TitleList);
  853.   WinBox^.NewList(TitleList);
  854. end; {...TWindowList.Load }
  855.  
  856.  
  857. procedure TWindowList.SelectWindow;
  858. { Selects a window in the desktop }
  859.  
  860.     function SameTitle(CurrWin: PWindow): boolean; Far;
  861.     begin
  862.       if CurrWin^.Title^ = WinBox^.GetText(WinBox^.Focused, 256) then
  863.          SameTitle := True
  864.       else
  865.          SameTitle := False;
  866.     end; {...SameTitle }
  867.  
  868. begin
  869.   PWindow(DeskTop^.FirstThat(@SameTitle))^.Select;
  870. end; {...TWindowList.SelectWindow }
  871.  
  872. procedure TWindowList.Store(var S: TStream);
  873. begin
  874.   TDialog.Store(S);
  875.   PutSubViewPtr(S, WinBox);
  876. end; {...TWindowList.Store }
  877.  
  878.  
  879. destructor TWindowList.Done;
  880. begin
  881.    if NOT(WinBox^.List = NIL) then
  882.      Dispose (WinBox^.List, Done);
  883.    TDialog.Done;
  884. end; {...TWindowList.Done }
  885.  
  886.  
  887.  
  888. {** TWindowListbox **}
  889.  
  890. procedure TWindowListBox.HandleEvent(var Event:TEvent);
  891. { Handles double-clicking by generating a cmOk event }
  892. begin
  893.   if (Event.What = evMouseDown) and (Event.Double) then
  894.     begin
  895.       Event.What := evCommand;
  896.       Event.Command := cmOK;
  897.       PutEvent(Event);
  898.       ClearEvent(Event);
  899.     end {...if (Event.What = evMouseDown) and (Event.Double) }
  900.   else
  901.     TSortedListBox.HandleEvent(Event);
  902. end; {...TWindowListBox.HandleEvent }
  903.  
  904.  
  905.  
  906. {** TWinTitleCollection **}
  907.  
  908. constructor TWinTitleCollection.Init(ALimit, ADelta: Integer);
  909. begin
  910.    TStringCollection.Init(ALimit, ADelta);
  911.    Status := 0;
  912. end; {...TWinTitleCollection.Init }
  913.  
  914.  
  915. procedure TWinTitleCollection.Error(Code, Info: Integer);
  916. { Sets the status attribute to 1 so that any external method or procedure
  917.   knows when an error has ocurred }
  918. begin
  919.    Status := 1;
  920. end; {...TWinTitleCollection.Error }
  921.  
  922.  
  923. {** CalcName function **}
  924.  
  925. function CalcName(AName: String): PathStr;
  926. { Calculates the path name of the given file, by searching the directory
  927.   of the .EXE file and the DOS Path}
  928. var
  929.   PathName : PathStr;
  930.   Dir: DirStr;
  931.   Name: NameStr;
  932.   Ext: ExtStr;
  933. begin
  934.   FSplit(ParamStr(0), Dir, Name, Ext);
  935.   if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  936.   PathName := FSearch(AName, Dir);
  937.   if PathName = '' then
  938.     PathName := FSearch(AName, GetEnv('PATH'));
  939.   CalcName := PathName;
  940. end; {...CalcName }
  941.  
  942.  
  943. {** NewNumberAvailable function **}
  944.  
  945. function NewNumberAvailable (var NewFileNumber:Integer;
  946.   var FilesOpen:FileNumbers):Boolean;
  947. { Keeps track of which FileNumbers have been used and returns the lowest
  948.   available number }
  949. var
  950.   Number : Integer;
  951. begin
  952.   NewNumberAvailable := False;
  953.   for Number := 1 to MaxNumberofFiles do
  954.     if not (Number in FilesOpen) then
  955.     begin
  956.       NewFileNumber := Number;
  957.       FilesOpen := FilesOpen + [NewFileNumber];
  958.       NewNumberAvailable := True;
  959.       Exit;
  960.     end; {...if not (Number in FilesOpen ) }
  961. end; {...NewNumberAvailable }
  962.  
  963.  
  964. {** Registration records **}
  965.  
  966. const
  967.    RMySpreadSheet : TStreamRec = (
  968.       ObjType : 1100;
  969.       VmtLink : Ofs(TypeOf(TMySpreadSheet)^);
  970.       Load    : @TMySpreadSheet.Load;
  971.       Store   : @TMySpreadSheet.Store
  972.    );
  973.  
  974. {** RegisterAll procedure **}
  975.  
  976. procedure RegisterAll;
  977. begin
  978.   RegisterType(RStringList);
  979.   RegisterDialogs;
  980.   RegisterViews;
  981.   RegisterStdDlg;
  982.   RegisterMenus;
  983.   RegisterHelpFile;
  984.   RegisterSpreadSheet;
  985.   RegisterType(RMySpreadSheet);
  986. end; {...RegisterAll }
  987.  
  988. {****************************************************************************}
  989. {                               MAIN PROGRAM                                 }
  990. {****************************************************************************}
  991.  
  992. var
  993.   Demo : TOOGridLibraryDemo;
  994.  
  995. begin
  996.   RegisterAll;
  997.   SaveMem := MemAvail;
  998.  
  999.   DemoResource.Init(New(PBufStream, Init(ResourceFileName, stOpenRead, 1024)));
  1000.   if DemoResource.Stream^.Status <> stOk then
  1001.   begin
  1002.     writeln('Resource not found...program aborted');
  1003.     halt(1);
  1004.   end; {...if DemoResource.Stream^.Status <> stOk }
  1005.  
  1006.   DemoStrings := PStringList(DemoResource.Get('Strings'));
  1007.  
  1008.   { Assign values to the GLResFile and GLStringList pointers in the
  1009.     GLTSheet units, so that the spreadsheet object knows where to
  1010.     find the resources it needs }
  1011.  
  1012.   GLResFile := @DemoResource;
  1013.   GLStringList := PStringList(DemoResource.Get('SheetStrings'));
  1014.  
  1015.   if DemoResource.Stream^.Status <> stOk then
  1016.   begin
  1017.     writeln('Problems accesing resource file...program aborted');
  1018.     halt(1);
  1019.   end; {...if DemoResource.Stream^.Status <> stOk }
  1020.   Demo.Init('');
  1021.   Demo.Run;
  1022.   Demo.Done;
  1023.  
  1024.   Dispose(GLStringList, Done);
  1025.   Dispose(DemoStrings, Done);
  1026.   DemoResource.Done;
  1027.  
  1028.   if MemAvail <> SaveMem then
  1029.   begin
  1030.     writeln('Memory not de-allocated: ', MemAvail-SaveMem);
  1031.     writeln;
  1032.   end; {...if MemAvail <> SaveMem }
  1033. end. {...Program OOGL_DemoProgram }
  1034.